home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
AMIGA
/
AMICUS
/
AMICUS24.ADF
/
bmon
/
BMon
(
.txt
)
next >
Wrap
AmigaBASIC Source Code
|
1988-04-16
|
10KB
|
492 lines
'(C) Sten Linnarsson
'Try these sequences:
'
'=FC0000r10s+ Will show beginning of
' kickstart (;kick)
'
';intu;nnam Shows intuition name
';offs Blanks the pointer
';exec;scan Shows some libnodes
'Otherwise, use trial-and-error. If you
'find a bug, then correct it! Use this
'program in any way you wish, as long
'as you don't think I would mind. If
'you think I would, then don't do it!
Init:
DIM com$(50,3),p%(3),d$(15)
temp#=0
l=1
s$=";exec" 'Auto-execute exec
C$=""
errcont=0 'break on error
align=0 'no align
version$="v3.0"
'For command-interpreter
com$(0,1)="dummy string"
i=0
READ com$(i,1),com$(i,2),com$(i,3)
WHILE com$(i,1)<>"NULL"
i=i+1
READ com$(i,1),com$(i,2),com$(i,3)
WEND
maxcom=i-1
'For tiny disassembler
FOR i=0 TO 15
READ d$(i)
NEXT
WINDOW 3,,,0
'Temporary background window
WINDOW CLOSE 1
POKEW 14676118,32
GOSUB CopyrightNotice
'Display a *fancy* logo with
'copyright notice...
'Now wait for click.
WHILE MOUSE(0)=0:WEND
WHILE MOUSE(0)=1:WEND
'And poke DMACON to show pointer
POKEW 14676118,32800
WINDOW 2," ",(389,0)-(631,186),16
PRINT "g JSR to current ad"
PRINT "; Execute command"
PRINT "r Repeat command"
PRINT "= Change ad"
PRINT "! Change byte at ad"
PRINT "@ Change word at ad"
PRINT "# Change long at ad"
PRINT "< Decrement ad"
PRINT "> Increment ad"
PRINT "+ Increment one frame"
PRINT "- Decrement one frame"
PRINT "w Advance a word '>>'"
PRINT "l Advance a long '>>>>'"
PRINT "j Jump to offset"
PRINT "u Jump back (unjump)"
PRINT "h Show a frame of hex"
PRINT "s Show a frame of text"
PRINT "c Show commands"
PRINT "? Information"
PRINT "q Quits"
WINDOW 1,"BMON "+version$+" by Sten Linnarsson",(0,0)-(382,186),16
WINDOW CLOSE 3
Menus:
MENU 5,0,1,"BMON "+version$
MENU 5,1,2," ErrBrk "
MENU 5,2,1," ErrCont "
MENU 5,3,0," "
MENU 5,4,2," BrkTrap "
MENU 5,5,1," NoBrkTrap"
MENU 5,6,0," "
MENU 5,7,2," NoAlign "
MENU 5,8,1," AlignText"
ON MENU GOSUB MenuHandle
MENU ON
ON BREAK GOSUB BreakHandle
BREAK ON
Loop:
C$=MID$(s$,1,1)
s$=MID$(s$,2,LEN(s$))
IF C$<>"" THEN
ComGo:
IF C$="g" THEN
INPUT "Are you sure ?";yesno$
IF yesno$="yes" THEN CALL ad#
END IF
ComIgnore:
IF C$="'" THEN
s$=""
END IF
ComSetAd:
IF C$="=" THEN
IF LEN(LEFT$(s$,6))=6 THEN
ToHex(LEFT$(s$,6))
ad#=dec&
s$=RIGHT$(s$,LEN(s$)-6)
ELSE
INPUT "ad= ",a$
ToHex(a$)
IF LEN(a$)<=6 THEN ad#=dec&
END IF
END IF
ComInfo:
IF C$="?" THEN
PRINT "BMON ";version$
PRINT "(C) Sten Linnarsson"
PRINT
PRINT "This software is in the "
PRINT "Public Domain. It may be "
PRINT "duplicated ONLY if "
PRINT
PRINT "1 The copyright screen is unchanged"
PRINT "2 You do not profit"
PRINT "3 The first line reads '(C) Sten Linnarsson'"
END IF
ComList:
IF C$="c" THEN
FOR i=0 TO maxcom
PRINT com$(i,1);" ";com$(i,3)
NEXT
END IF
ComIncDec:
IF C$="<" THEN ad#=ad#-1
IF C$="-" THEN ad#=ad#-16
IF C$="+" THEN ad#=ad#+16
IF C$=">" THEN ad#=ad#+1
IF C$="w" THEN ad#=ad#+2
IF C$="l" THEN ad#=ad#+4
ComExecute:
IF C$=";" THEN
FOR i=0 TO maxcom
IF LEFT$(s$,4)=com$(i,1) THEN s$=com$(i,2)+RIGHT$(s$,LEN(s$)-4)
NEXT
END IF
ComJump:
IF C$="j" THEN
UnJump#=ad#
IF PEEKL(ad#)<=5.42414e-315 THEN
ad#=PEEKL(ad#)
ELSE
PRINT "Address out of range"
PRINT "Higher than $FFFFF0, 16777205"
IF errcont=0 THEN s$="":Repeat=0:GOTO Loop
END IF
END IF
ComUnJump:
IF C$="u" THEN
temp#=ad#
ad#=UnJump#
UnJump#=temp#
END IF
ComPoke:
IF C$="!" THEN
IF LEN(LEFT$(s$,2))=2 THEN
ToHex(LEFT$(s$,2))
POKE ad#,dec&
s$=RIGHT$(s$,LEN(s$)-2)
ELSE
INPUT "byte= ",a$
IF a$<>"" THEN
ToHex(a$)
POKE ad#,dec&
END IF
END IF
END IF
'Does not check for even-byte address
IF C$="@" THEN
IF LEN(LEFT$(s$,4))=4 THEN
ToHex(LEFT$(s$,4))
POKEW ad#,dec&
s$=RIGHT$(s$,LEN(s$)-4)
ELSE
INPUT "word= ",a$
IF a$<>"" THEN
ToHex(a$)
POKEW ad#,dec&
END IF
END IF
END IF
'Does not check for even-byte address
IF C$="#" THEN
IF LEN(LEFT$(s$,8))=8 THEN
ToHex(LEFT$(s$,8))
POKEL ad#,dec&
s$=RIGHT$(s$,LEN(s$)-8)
ELSE
INPUT "long= ",a$
IF a$<>"" THEN
ToHex(a$)
POKEL ad#,dec&
END IF
END IF
END IF
ComHex:
IF C$="h" THEN
PRINT HEX$(ad#);": ";
FOR i=0 TO 15
x$=HEX$(PEEK(ad#+i))
IF LEN(x$)=1 THEN x$="0"+x$
PRINT x$;
PRINT PTAB(WINDOW(4)+2);
NEXT
PRINT
END IF
ComText:
IF C$="s" THEN
PRINT HEX$(ad#);": ";
PRINT PTAB(WINDOW(4)+4);
FOR i=0 TO 15
x=PEEK(ad#+i)
IF x<32 OR x>126 THEN x=95
PRINT CHR$(x);
IF align=1 THEN PRINT PTAB(WINDOW(4)+10);
NEXT
PRINT
END IF
ComRepeat:
IF C$="r" THEN Repeat=VAL(LEFT$(s$,2))-1:s$=RIGHT$(s$,LEN(s$)-2):r$=s$
ComQuit:
IF C$="q" THEN
PRINT "Quitting..."
END
END IF
ELSE
IF Repeat>1 THEN
s$=r$
Repeat=Repeat-1
ELSE
PRINT HEX$(ad#);
INPUT "> ",s$
END IF
END IF
GOTO Loop
MenuHandle:
IF MENU(0)=5 THEN
MENU OFF
IF MENU(1)=1 THEN
MENU 5,1,2
MENU 5,2,1
errcont=0
END IF
IF MENU(1)=2 THEN
MENU 5,1,1
MENU 5,2,2
errcont=1
END IF
IF MENU(1)=4 THEN
MENU 5,4,2
MENU 5,5,1
BREAK ON
END IF
IF MENU(1)=5 THEN
MENU 5,4,1
MENU 5,5,2
BREAK OFF
END IF
IF MENU(1)=7 THEN
MENU 5,7,2
MENU 5,8,1
align=0
END IF
IF MENU(1)=8 THEN
MENU 5,7,1
MENU 5,8,2
align=1
END IF
MENU ON
END IF
RETURN
BreakHandle:
PRINT "^C --- Break Trap Set"
RETURN
CopyrightNotice:
type=0
WHILE type<>-1
READ type
IF type=1 THEN
READ x1,y1,x2,y2,co
LINE (x1,y1)-(x2,y2),co,bf
END IF
IF type=2 THEN
READ x1,y1,x2,y2,co
LINE (x1,y1)-(x2,y2),co
END IF
IF type=3 THEN
READ x,y,r,C
CIRCLE (x,y),r,C
END IF
IF type=4 THEN
READ x,y,co
PAINT (x,y),co
END IF
IF type=5 THEN
READ x,y,cf,cb,txt$
LOCATE y,x
COLOR cf,cb
PRINT txt$;
END IF
IF type=6 THEN
READ p%(0),p%(1),p%(2),p%(3),lpat
PATTERN lpat,p%
END IF
IF type=7 THEN
READ x1,y1,x2,y2,co
LINE (x1,y1)-(x2,y2),co,b
END IF
WEND
'Hide pointer. (Sometimes causes a
'tall strip to show. No harm though.)
POKEW 14676118,33024
RETURN
'ToHex(hexstring)
'
'Note that this sub converts hex to dec
'and NOT dec to hex as its name suggest
'(Name kept for historical reasons)
'uses lowercase chars
'returns the decimal value in 'dec&'
SUB ToHex(value$) STATIC
SHARED dec&
h$="0123456789abcdef"
dec&=0
FOR i=1 TO LEN(value$)
dec&=dec&*16
dec&=dec&+INSTR(h$,MID$(value$,i,1))-1
NEXT
END SUB
'command format: NAME,string,info
Commands:
DATA "exec","=000000lj","Jumps to ExecBase structure"
'(Peeks location 4 for offset. 4 is AbsExecBase
DATA "libr","ll>>l>>wwwwllw","Skip 1 Library structure"
DATA "node","ll>>l","Skip 1 node structure"
DATA "intv","lll","Skip 1 IntVector structure"
DATA "task",";exec;libr wwlllllllllllwr16;intv","Go to *ThisTask"
DATA "list","lllwww>> wwl llllw","Go from *ThisTask to MemList"
DATA "slst","lll>>","Skip 1 List structure"
DATA "nnam","ll>>js","Show node name"
DATA "kick","=f80000r13s+","Show start of kick mem"
DATA "intu",";exec r04j","Go to IntuitionBase"
DATA "scan","r10;nnamu<<<<<<<<<<j","Scans next 10 nodes in list"
DATA "offs","=dff096r10@0020","Turn sprite DMA off"
DATA "offd","=dff096r10@0100","Turn display DMA off"
DATA "kill","=000008r10#00000000l","Kill system (VERY fun!)"
DATA "NULL","?","End-of-commands"
'Should always be the last command
DisData:
'Tiny disassembler
'examines bits 12-15
'for op-code general type.
'See 'Programming the 68000' pp. 500
DATA "Bit manipulation/MOVEP/Immediate"
DATA "Move Byte"
DATA "Move Long"
DATA "Move Word"
DATA "Miscellaneous"
DATA "ADDQ/SUBQ/Scc/DBcc"
DATA "Bcc/BSR"
DATA "MOVEQ"
DATA "OR/DIV/SBCD"
DATA "SUB/SUBX"
DATA "(unassigned)"
DATA "CMP/EOR"
DATA "AND/MUL/ABCD/EXG"
DATA "ADD/ADDX"
DATA "ASL/ASR/ROL/ROR/ROXL/ROXR"
DATA "(unassigned)"
CopyrightData:
'format:
'a number specifying the type of the
'data, followed by the actual data
'Types:
' -1 end of data
' 1 filled box
' 2 line
' 3 circle
' 4 paint
' 5 text
' 6 pattern
' 7 empty box
DATA 1,50,50,590,150,3
DATA 7,50,50,590,150,2
DATA 3,320,100,90,2
DATA 6,&hf0f0,&ha6a6,&h5555,&h3333,&hffff
DATA 4,600,150,2
DATA 6,&hff00,&h0ff0,&h00ff,&hf00f,&hffff
DATA 4,320,100,2
DATA 5,37,1,1,2,"BMON"
DATA 5,25,3,3,2,"The system structure monitor"
DATA 5,25,4,3,2,"Developed by Sten Linnarsson"
VersionNumber:
DATA 5,33,13,1,0,"v3.0 17-Sep-1987"
DATA 5,30,20,0,1,"Press mouse button..."
DATA 5,10,11,1,3,"This program is"
DATA 5,10,12,1,3,"Public Domain."
DATA 5,10,13,1,3,"Type ? for more"
DATA 5,10,14,1,3,"info about this"
DATA 5,10,15,1,3,"type of software."
DATA 5,54,11,1,3,"Sten Linnarsson"
DATA 5,54,12,1,3,"Vintertullstorget 20"
DATA 5,54,13,1,3,"S-116 43 Stockholm"
DATA 5,54,14,1,3,"Sweden"
DATA 5,54,15,1,3,"08/7149564"
DATA -1